home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / Dialog.sed < prev    next >
Text File  |  1992-11-24  |  15KB  |  463 lines
  1. (* Ich, Doktor Josef Grosch, Informatiker, 23.5.1989 *)
  2.  
  3. IMPLEMENTATION MODULE Dialog;
  4.  
  5. FROM SYSTEM    IMPORT TSIZE;
  6. FROM DynArray    IMPORT MakeArray, ExtendArray, ReleaseArray;
  7. FROM IO        IMPORT StdInput, ReadC, StdOutput, WriteI, WriteS, WriteNl;
  8. FROM Strings    IMPORT tString, ArrayToString, WriteL;
  9. FROM Idents    IMPORT tIdent, MakeIdent, WriteIdent;
  10.  
  11. FROM Sets    IMPORT
  12.    tSet        , MakeSet    , ReleaseSet    , IsElement    ;
  13.  
  14. FROM Relations    IMPORT
  15.    tRelation    , MakeRelation    , ReleaseRelation, Closure    ,
  16.    IsRelated    , Assign    , Difference    , GetCyclics    ;
  17.  
  18. FROM Tree    IMPORT
  19.    NoTree    , tTree        , tInstance    ,
  20.    Computed    , Reverse    , Write        , Read        ,
  21.    Inherited    , Synthesized    , Input        , Output    ,
  22.    Stack    , Parameter    , Variable    ,
  23.    CopyDef    , CopyUse    , Thread    , Test        ,
  24.    Left        , Right        , Def        , Use        ,
  25.    ChildUse    , ParentUse    , NonBaseComp    , First        ,
  26.    Dummy    , Virtual    , Demand    , f        ,
  27.    WriteName    , WriteDependencies, WriteClass    , MaxSet    ,
  28.    GrammarClass    , cLNC    , cDNC    , cLAG    , cOAG    , cSAG    , cSNC    ,
  29.    QueryTree    , IdentifyClass    , IdentifyAttribute;
  30.  
  31. FROM Order    IMPORT WriteOrderDecl, WriteOrderEval, WriteVisitSequence, IndexToClass;
  32.  
  33. IMPORT Tree;
  34.  
  35. TYPE tDepend    = RECORD A, B: SHORTCARD; Rule: tTree; END;
  36.  
  37. VAR
  38.    Cyclics    : tSet;
  39.    ClassCount    : SHORTCARD;
  40.    String    : tString;
  41.  
  42.    MarkSize    : LONGINT;
  43.    MarkPtr    : POINTER TO ARRAY [0 .. 10000] OF tDepend;
  44.    MarkCount    : INTEGER;
  45.  
  46.    TraceSize    : LONGINT;
  47.    TracePtr    : POINTER TO ARRAY [0 .. 10000] OF tDepend;
  48.    TraceCount    : INTEGER;
  49.  
  50. PROCEDURE Find (a, b: SHORTCARD; rule: tTree): BOOLEAN;
  51.    VAR
  52.       c, UserIndex        : SHORTCARD;
  53.       i, markCount, traceCount    : INTEGER;
  54.       DPClosure            : tRelation;
  55.       UserClass            : tTree;
  56.  
  57.    PROCEDURE ForallClasses (t: tTree): BOOLEAN;
  58.       BEGIN
  59.      IF t^.Kind = Tree.Class THEN
  60.         WITH rule^.Class DO
  61.            WITH Instance^[a].Selector^.Child DO
  62.           IF Find (a - AttrCount - InstOffset, b - AttrCount - InstOffset, t) THEN
  63.              RETURN TRUE;
  64.           END;
  65.            END;
  66.         END;
  67.         IF ForallClasses (t^.Class.Extensions) THEN RETURN TRUE; END;
  68.         RETURN ForallClasses (t^.Class.Next);
  69.      ELSE
  70.         RETURN FALSE;
  71.      END;
  72.       END ForallClasses;
  73.  
  74.    PROCEDURE ForallAttributes (t: tTree): BOOLEAN;
  75.       BEGIN
  76.      CASE t^.Kind OF
  77.      | Tree.Class:
  78.            IF ForallAttributes (t^.Class.BaseClass) THEN
  79.           RETURN TRUE;
  80.            ELSE
  81.           RETURN ForallAttributes (t^.Class.Attributes);
  82.            END;
  83.      | Tree.Child:
  84.            WITH UserClass^.Class DO WITH t^.Child DO
  85.           IF (Class = rule) AND
  86.              Find (AttrCount + InstOffset + a, AttrCount + InstOffset + b, UserClass) THEN
  87.              RETURN TRUE;
  88.           END;
  89.            END; END;
  90.            RETURN ForallAttributes (t^.Child.Next);
  91.      | Tree.Attribute:
  92.            RETURN ForallAttributes (t^.Attribute.Next);
  93.      | Tree.ActionPart:
  94.            RETURN ForallAttributes (t^.ActionPart.Next);
  95.      ELSE
  96.            RETURN FALSE;
  97.      END;
  98.       END ForallAttributes;
  99.  
  100.    BEGIN
  101.       WITH rule^.Class DO
  102.      IF NOT (((cSNC IN GrammarClass) AND IsRelated (a, b, DNC)) OR
  103.              ((cLNC IN GrammarClass) AND IsRelated (a, b, SNC))) THEN RETURN FALSE; END;
  104.  
  105.      FOR i := 1 TO MarkCount DO    (* IF (a, b, rule) IN Mark THEN RETURN FALSE *)
  106.         WITH MarkPtr^ [i] DO
  107.            IF (a = A) AND (b = B) AND (rule = Rule) THEN RETURN FALSE; END;
  108.         END;
  109.      END;
  110.  
  111.      INC (MarkCount);        (* Mark := Mark UNION (a, b, rule)    *)
  112.      IF MarkCount = MarkSize THEN
  113.         ExtendArray (MarkPtr, MarkSize, TSIZE (tDepend));
  114.      END;
  115.      WITH MarkPtr^ [MarkCount] DO
  116.         A := a; B := b; Rule := rule;
  117.      END;
  118.  
  119.      markCount    := MarkCount;    (* Mark = set checkpoint        *)
  120.      traceCount    := TraceCount;
  121.  
  122.          MakeRelation (DPClosure, InstCount, InstCount);
  123.      Assign (DPClosure, DP);
  124.      Closure (DPClosure);
  125.      IF IsRelated (a, b, DPClosure) THEN
  126.         FOR c := 1 TO InstCount DO
  127.            IF IsRelated (a, c, DP) AND (IsRelated (c, b, DPClosure) OR (c = b)) THEN
  128.           INC (TraceCount);
  129.           IF TraceCount = TraceSize THEN
  130.              ExtendArray (TracePtr, TraceSize, TSIZE (tDepend));
  131.           END;
  132.           WITH TracePtr^ [TraceCount] DO
  133.              A := a; B := c; Rule := rule;
  134.           END;
  135.           ReleaseRelation (DPClosure);
  136.           RETURN (c = b) OR Find (c, b, rule);
  137.            END;
  138.         END;
  139.      END;
  140.      ReleaseRelation (DPClosure);
  141.  
  142.      IF (Right IN Instance^[a].Properties) AND (Right IN Instance^[b].Properties) AND
  143.         (Instance^[a].Selector = Instance^[b].Selector) AND (Instance^[a].Selector # NoTree) THEN
  144.         WITH Instance^[a].Selector^.Child DO
  145.            IF Find (a - AttrCount - InstOffset, b - AttrCount - InstOffset, Class) THEN
  146.           RETURN TRUE;
  147.            END;
  148.            IF ForallClasses (Class^.Class.Extensions) THEN RETURN TRUE; END;
  149.         END;
  150.      END;
  151.  
  152.      IF (Left IN Instance^[a].Properties) AND (Left IN Instance^[b].Properties) THEN
  153.         FOR UserIndex := 1 TO ClassCount DO
  154.            IF IsElement (UserIndex, Users) THEN
  155.           UserClass := IndexToClass^[UserIndex];
  156.           IF ForallAttributes (UserClass) THEN RETURN TRUE; END;
  157.            END;
  158.         END;
  159.      END;
  160.  
  161.      IF cLNC IN GrammarClass THEN
  162.         FOR c := 1 TO InstCount DO
  163.            IF IsRelated (a, c, SNC) AND IsRelated (c, b, SNC) AND
  164.           Find (a, c, rule) AND Find (c, b, rule) THEN RETURN TRUE; END;
  165.         END;
  166.      END;
  167.  
  168.      IF cSNC IN GrammarClass THEN
  169.         FOR c := 1 TO InstCount DO
  170.            IF IsRelated (a, c, DNC) AND IsRelated (c, b, DNC) AND
  171.           Find (a, c, rule) AND Find (c, b, rule) THEN RETURN TRUE; END;
  172.         END;
  173.      END;
  174.  
  175.      MarkCount    := markCount;    (* Release = return to last checkpoint    *)
  176.      TraceCount    := traceCount;
  177.      RETURN FALSE;
  178.       END;
  179.    END Find;
  180.  
  181. PROCEDURE FindPath (a, b: SHORTCARD; rule: tTree);
  182.    VAR i    : INTEGER;
  183.    BEGIN
  184.       WITH rule^.Class DO
  185.      WriteIdent    (StdOutput, Name);
  186.      WriteS        (StdOutput, "    ");
  187.      WriteName    (Instance^ [a]);
  188.      WriteS        (StdOutput, "    ");
  189.      WriteName    (Instance^ [b]);
  190.      WriteNl    (StdOutput);
  191.      WriteNl    (StdOutput);
  192.       END;
  193.       MarkSize := 32;
  194.       MakeArray (MarkPtr, MarkSize, TSIZE (tDepend));
  195.       MarkCount := 0;
  196.       TraceSize := 32;
  197.       MakeArray (TracePtr, TraceSize, TSIZE (tDepend));
  198.       TraceCount := 0;
  199.       IF Find (a, b, rule) THEN
  200.      FOR i := 1 TO TraceCount DO
  201.         WITH TracePtr^ [i] DO
  202.            WriteIdent    (StdOutput, Rule^.Class.Name);
  203.            WriteS        (StdOutput, "    ");
  204.            WriteName    (Rule^.Class.Instance^ [A]);
  205.            WriteS        (StdOutput, "    ");
  206.            WriteName    (Rule^.Class.Instance^ [B]);
  207.            WriteNl        (StdOutput);
  208.         END;
  209.      END;
  210.       END;
  211.       ReleaseArray (MarkPtr, MarkSize, TSIZE (tDepend));
  212.       ReleaseArray (TracePtr, TraceSize, TSIZE (tDepend));
  213.    END FindPath;
  214.  
  215. PROCEDURE Menue;
  216.    BEGIN
  217.       f := StdOutput;
  218.       !!
  219.       ! Dialog System!
  220.       !!
  221.       !   <name>          select current node type (rule)!
  222.       ! t <name>          select current node type (rule)!
  223.       ! a <name>[:<name>] select current attribute instance a!
  224.       ! b <name>[:<name>] select current attribute instance b!
  225.       !!
  226.       ! P print dependency relation DP  for complete node type!
  227.       ! p print dependency relation DP  for current attribute instance!
  228.       ! S print dependency relation SNC for complete node type!
  229.       ! s print dependency relation SNC for current attribute instance!
  230.       ! N print dependency relation DNC for complete node type!
  231.       ! n print dependency relation DNC for current attribute instance!
  232.       ! O print dependency relation OAG for complete node type!
  233.       ! o print dependency relation OAG for current attribute instance!
  234.       ! C print dependencies introduced for total order for complete node type!
  235.       ! c print dependencies introduced for total order for cyclic attributes!
  236.       ! G print attribute instances sorted by declaration order!
  237.       ! E print attribute instances sorted by evaluation order!
  238.       ! V print visit sequence!
  239.       ! F search for and print dependency path between attributes a and b!
  240.       ! M print summary of node type (rule) from source!
  241.       ! Q browse internal data structure of complete attribute grammar!
  242.       ! q browse internal data structure of current node type!
  243.       ! h print menue for dialog system!
  244.       ! ? print current state!
  245.       ! x exit dialog system!
  246.       !!
  247.    END Menue;
  248.  
  249. PROCEDURE Dialog (t: tTree);
  250.    VAR
  251.       Com, Ch        : CHAR;
  252.       Class, ChildsClass: tTree;
  253.       Attribute        : tTree;
  254.       Name0, Name1, Name2    : ARRAY [0..64] OF CHAR;
  255.       Length0, Length1, Length2    : INTEGER;
  256.       Ident        : tIdent;
  257.       a, b, Offset    : SHORTCARD;
  258.    BEGIN
  259.       Menue;
  260.       Class := NoTree;
  261.       a := 0;
  262.       b := 0;
  263.  
  264.       LOOP
  265.      WriteS (StdOutput, "? ");
  266.      Ch := ReadC (StdInput);
  267.  
  268.          Length0 := -1;
  269.          WHILE (Ch > ' ') AND (Ch # ':') DO
  270.         INC (Length0); Name0 [Length0] := Ch; Ch := ReadC (StdInput);
  271.      END;
  272.      Name0 [Length0 + 1] := 0C;
  273.  
  274.          WHILE (Ch <= ' ') AND (Ch # 12C) OR (Ch = ':') DO
  275.         Ch := ReadC (StdInput);
  276.      END;
  277.  
  278.          Length1 := -1;
  279.          WHILE (Ch > ' ') AND (Ch # ':') DO
  280.         INC (Length1); Name1 [Length1] := Ch; Ch := ReadC (StdInput);
  281.      END;
  282.      Name1 [Length1 + 1] := 0C;
  283.  
  284.          WHILE (Ch <= ' ') AND (Ch # 12C) OR (Ch = ':') DO
  285.         Ch := ReadC (StdInput);
  286.      END;
  287.  
  288.          Length2 := -1;
  289.          WHILE (Ch > ' ') AND (Ch # ':') DO
  290.         INC (Length2); Name2 [Length2] := Ch; Ch := ReadC (StdInput);
  291.      END;
  292.      Name2 [Length2 + 1] := 0C;
  293.  
  294.          WHILE Ch # 12C DO Ch := ReadC (StdInput); END;
  295.  
  296.      IF Length0 = 0 THEN
  297.         Com := Name0 [0];
  298.         CASE Com OF
  299.         | 't',
  300.           'T': (* <name>          select current node type (rule)    *)
  301.              ArrayToString (Name1, String);
  302.              Ident := MakeIdent (String);
  303.              Class := IdentifyClass (t^.Ag.Classes, Ident);
  304.              IF Class = NoTree THEN
  305.             WriteS (StdOutput, "unknown node type: ");
  306.             WriteL (StdOutput, String);
  307.              END;
  308.         | 'a',
  309.           'A', (* <name>[:<name>] select current attribute instance a    *)
  310.           'b',
  311.           'B': (* <name>[:<name>] select current attribute instance b    *)
  312.              ArrayToString (Name1, String);
  313.              Ident := MakeIdent (String);
  314.              Attribute := IdentifyAttribute (Class, Ident);
  315.              IF Attribute = NoTree THEN
  316.             WriteS (StdOutput, "unknown attribute: ");
  317.             WriteL (StdOutput, String);
  318.              ELSE
  319.             IF (Com = 'a') OR (Com = 'A') THEN
  320.                a := Attribute^.Child.AttrIndex;
  321.             ELSE
  322.                b := Attribute^.Child.AttrIndex;
  323.             END;
  324.             IF Length2 >= 0 THEN
  325.                ChildsClass := Attribute^.Child.Class;
  326.                IF ChildsClass # NoTree THEN
  327.                   ArrayToString (Name2, String);
  328.                   Ident := MakeIdent (String);
  329.                   Offset := Class^.Class.AttrCount + Attribute^.Child.InstOffset;
  330.                   Attribute := IdentifyAttribute (ChildsClass, Ident);
  331.                   IF Attribute = NoTree THEN
  332.                  WriteS (StdOutput, "unknown attribute: ");
  333.                  WriteL (StdOutput, String);
  334.                   ELSE
  335.                  IF (Com = 'a') OR (Com = 'A') THEN
  336.                     a := Offset + Attribute^.Child.AttrIndex;
  337.                  ELSE
  338.                     b := Offset + Attribute^.Child.AttrIndex;
  339.                  END;
  340.                   END;
  341.                END;
  342.             END;
  343.              END;
  344.         | 'P': (* print dependency relation DP  for complete node type (rule)    *)
  345.              WriteDependencies (Class, Class^.Class. DP, MaxSet);
  346.         | 'p': (* print dependency relation DP  for current attribute instance    *)
  347.              WriteDependencies (Class, Class^.Class. DP, MaxSet);
  348.         | 'S': (* print dependency relation SNC for complete node type (rule)    *)
  349.              WriteDependencies (Class, Class^.Class. SNC, MaxSet);
  350.         | 's': (* print dependency relation SNC for current attribute instance    *)
  351.              WriteDependencies (Class, Class^.Class. SNC, MaxSet);
  352.         | 'N': (* print dependency relation DNC for complete node type (rule)    *)
  353.              WriteDependencies (Class, Class^.Class. DNC, MaxSet);
  354.         | 'n': (* print dependency relation DNC for current attribute instance    *)
  355.              WriteDependencies (Class, Class^.Class. DNC, MaxSet);
  356.         | 'O': (* print dependency relation OAG for complete node type (rule)    *)
  357.              WriteDependencies (Class, Class^.Class. OAG, MaxSet);
  358.         | 'o': (* print dependency relation OAG for current attribute instance    *)
  359.              WriteDependencies (Class, Class^.Class. OAG, MaxSet);
  360.         | 'C': (* print dependencies introduced for total order for complete node type *)
  361.              IF (Class # NoTree) AND (cDNC IN GrammarClass) THEN
  362.             WITH Class^.Class DO
  363.                MakeRelation (Part, InstCount, InstCount);
  364.                Assign (Part, OAG);
  365.                Difference (Part, DNC);
  366.                WriteDependencies (Class, Part, MaxSet); WriteNl (StdOutput);
  367.                ReleaseRelation (Part);
  368.             END;
  369.              END;
  370.         | 'c': (* print dependencies introduced for total order for cyclic attributes *)
  371.              IF (Class # NoTree) AND (cDNC IN GrammarClass) THEN
  372.             WITH Class^.Class DO
  373.                MakeRelation (Part, InstCount, InstCount);
  374.                MakeSet (Cyclics, InstCount);
  375.                GetCyclics (OAG, Cyclics);
  376.                Assign (Part, OAG);
  377.                Difference (Part, DNC);
  378.                WriteDependencies (Class, Part, Cyclics);
  379.                ReleaseRelation (Part);
  380.                ReleaseSet (Cyclics);
  381.             END;
  382.              END;
  383.         | 'D',
  384.           'd',
  385.           'G',
  386.           'g': (* print attribute instances sorted by declaration    *)
  387.              WriteOrderDecl (Class);
  388.         | 'E',
  389.           'e': (* print attribute instances sorted by evaluation order    *)
  390.              IF cOAG IN GrammarClass THEN WriteOrderEval (Class); END;
  391.         | 'V',
  392.           'v': (* print visit sequence    *)
  393.              IF cOAG IN GrammarClass THEN WriteVisitSequence (Class); END;
  394.         | 'F',
  395.           'f': (* find and print dependency path between attributes a and b    *)
  396.              IF (Class # NoTree) AND
  397.             (1 <= a) AND (a <= Class^.Class.InstCount) AND
  398.             (1 <= b) AND (b <= Class^.Class.InstCount) THEN
  399.             FindPath (a, b, Class);
  400.              END;
  401.         | 'M',
  402.           'm': (* print summary of current node type (rule)    *)
  403.              WriteClass (Class);
  404.         | 'Q': (* browse internal data structure of complete attribute grammar    *)
  405.              QueryTree (t);
  406.         | 'q': (* browse internal data structure of current node type (rule)    *)
  407.              QueryTree (Class);
  408.         | 'h',
  409.           'H': (* print menue for dialog system    *)
  410.              Menue;
  411.         | 'x',
  412.           'X': (* exit dialog system    *)
  413.              EXIT;
  414.         | '?': (* print current state    *)
  415.              WriteS (StdOutput, "node type: ");
  416.              IF Class # NoTree THEN
  417.             WITH Class^.Class DO
  418.                WriteIdent    (StdOutput, Name);
  419.                WriteS    (StdOutput, ", a: ");
  420.                IF (1 <= a) AND (a <= Class^.Class.InstCount) THEN
  421.                   WriteName    (Instance^ [a]);
  422.                   WriteS    (StdOutput, " = ");
  423.                   WriteI    (StdOutput, a, 0);
  424.                ELSE
  425.                   WriteS    (StdOutput, "?");
  426.                END;
  427.                WriteS    (StdOutput, ", b: ");
  428.                IF (1 <= b) AND (b <= Class^.Class.InstCount) THEN
  429.                   WriteName    (Instance^ [b]);
  430.                   WriteS    (StdOutput, " = ");
  431.                   WriteI    (StdOutput, b, 0);
  432.                ELSE
  433.                   WriteS    (StdOutput, "?");
  434.                END;
  435.             END;
  436.              ELSE
  437.             WriteS    (StdOutput, "?, a: ?, b: ?");
  438.              END;
  439.              WriteNl (StdOutput);
  440.         ELSE
  441.              (* <name>          select current node type (rule)    *)
  442.              ArrayToString (Name0, String);
  443.              Ident := MakeIdent (String);
  444.              Class := IdentifyClass (t^.Ag.Classes, Ident);
  445.              IF Class = NoTree THEN
  446.             WriteS (StdOutput, "unknown node type: ");
  447.             WriteL (StdOutput, String);
  448.              END;
  449.         END;
  450.      ELSE
  451.         ArrayToString (Name0, String);
  452.         Ident := MakeIdent (String);
  453.         Class := IdentifyClass (t^.Ag.Classes, Ident);
  454.         IF Class = NoTree THEN
  455.            WriteS (StdOutput, "unknown node type: ");
  456.            WriteL (StdOutput, String);
  457.         END;
  458.      END;
  459.       END;
  460.    END Dialog;
  461.  
  462. END Dialog.
  463.